home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Grab Bag
/
Shareware Grab Bag.iso
/
090
/
wheels2.arc
/
LABEL.PAS
next >
Wrap
Pascal/Delphi Source File
|
1985-06-28
|
11KB
|
282 lines
{@@@@@@@@@@@ copyright (C) 1984 by Neil J. Rubenking @@@@@@@@@@@@@@@@@@@@@@@@
The purchaser of these procedures and functions may include them in COMPILED
programs freely, but may not sell or give away the source text.
sidesectortrack
This program uses a number of the procedures on this disk to
find, change, or create a volume label. You might think you
could simply FIND it with Find_First (from GETFILE.LIB) and
change it with a simple RENAME, or create a new file and set
its attribute to 8 (= Volume label) with FileAttribute (found
in FILEATTR.LIB. It ain't that easy! The only one of the
routines I just mentioned that will work is Find_First--the
others are deeply protected agains acting on the LABEL
This being the case, we seek the label by directly reading
and writing the directory sectors. It ain't elegant, but
it does the job.
}
{$I regpack.typ}
{$I disktyp.lib}
{$I grfxtabl.lib}
{$I titles.lib}
type
Label_type = string[11];
directory_entry = record
name : array[1..11] of char; { See the DOS 2.0 }
attribute : byte; { Manual, Appendix }
junk1 : array[1..10] of byte; { C, for description }
time : array[1..2] of byte; { of directory. But }
date : array[1..2] of byte; { don't look in the }
junk2 : array[1..6] of byte; { 2.1 Manual--they }
end; { took a lot of good }
buffer_type = array[1..16] of directory_entry; { stuff out! }
sector_loc = record
side, sector, track : byte;
end;
var
buffer : buffer_type;
drive : char;
label_sector, which_entry, free_sector, free_entry : byte;
N, M, P, error_return, attrib : byte;
the_label, new_label : label_type;
dir_sectors : array[1..7] of sector_loc;
{$I getsectr.lib}
var
OKAY, found : boolean;
{@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@}
procedure DirectoryMap; { This procedure checks what kind }
begin { of disk we're looking at and }
for N := 1 to 7 do { locates the sectors that contain }
with dir_sectors[N] do { the directory. }
side := 2;
case disktype(drive) of
160: begin
for N := 1 to 4 do
with dir_sectors[N] do
begin
side := 0;
track := 0;
sector := 3+N;
end;
end;
180: begin
for N := 1 to 4 do
with dir_sectors[N] do
begin
side := 0;
track := 0;
sector := 5+N;
end;
end;
320: begin
for N := 1 to 5 do
with dir_sectors[N] do
begin
side := 0;
track := 0;
sector := 3+N;
end;
for N := 6 to 7 do
with dir_sectors[N] do
begin
side := 1;
track := 0;
sector := N-5;
end;
end;
360: begin
for N := 1 to 4 do
with dir_sectors[N] do
begin
side := 0;
track := 0;
sector := 5+N;
end;
for N := 5 to 7 do
with dir_sectors[N] do
begin
side := 1;
track := 0;
sector := N-4;
end;
end;
else
WriteLn('Non-standard format. Halting program');
HALT;
end; {case}
end; {procedure}
{@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@}
procedure FindLabel;
begin
N := 0;
Free_entry := 0;
found := false;
repeat
N := N + 1;
if dir_sectors[N].side < 2 then {if side = 2 here, it means we've
run out of sectors on a single-
sided disk}
begin
with dir_sectors[N] do
begin
GetSector('R',drive,side,sector,track,OKAY);
{ GetSector dumps a sector into
the buffer. Because the buffer
is "shaped" like a directory, we
have instant access to the dir-
ectory information }
end;
if OKAY then
begin
for M := 1 to 16 do
begin
with buffer[M] do
begin
if ((name[1] = #0) or (name[1] = #229))
and (Free_Entry = 0) then { Note the first free }
begin { entry--a never-used }
Free_Entry := M; { one starts w/ chr(0), }
Free_Sector := N; { an erased one, with }
end; { chr(229) }
if attribute = 8 then
begin { Attribute = 8 means we have }
Label_sector := N; { found the label. }
which_entry := M;
found := true;
the_label := '';
for P := 1 to 11 do
the_label := the_label + name[P];
end;
end;
end;
end
else writeLn('Not OKAY!');
end;
until found or (not OKAY) or (dir_sectors[N].side = 2) or (N = 7);
end;
{@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@}
procedure WriteNewLabel;
begin
new_label[length(new_label)+1] := #0;
for P := 1 to 11 do
buffer[which_entry].name[P] := new_label[P];
with dir_sectors[label_sector] do
GetSector('W',drive,side,sector,track,OKAY);
if OKAY then
WriteLn('Sucessfully changed label of drive ',drive,' to ',new_label)
else
WriteLn('Not OKAY!');
end;
{@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@}
procedure CreateLabel;
var
registers : regpack;
{=================================================}
procedure GetTime(VAR Byt1,Byt2: byte);
var
hours, mins, twoSecs : byte; { The DOS TIME function delivers }
begin { hours, minutes and seconds in }
registers.AX := $2C shl 8; { one format, but the time info }
MSDOS(registers); { in the directory is formatted }
with registers do { quite differently. The point }
begin { of all the manipulation and }
hours := CX shr 8; { shifting left and right is to }
mins := CX and $00FF; { get the time info into this }
twoSecs := DX shr 9; { shape: }
end; { || }
{ \/ }
{ high byte low byte }
{bit # 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 0 }
{ | h h h h h | m m m m m m | s s s s s | }
{ | hour | minutes | 2-seconds | }
byt2 := (hours shl 3) + (mins shr 3);
byt1 := ((mins and 7) shl 5) + twoSecs;
end;
{=================================================}
procedure GetDate(VAR Byt1,Byt2: byte);
var
month, day : byte;
year : integer;
begin
registers.AX := $2A shl 8;
MSDOS(registers);
with registers do
begin
year := CX;
month := DX shr 8;
day := DX and $00FF;
end;
{ The date information in the directory entry is also in an odd format. }
{ high byte low byte }
{bit # 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 0 }
{ | y y y y y y y | m m m m | d d d d d | }
{ | year - 1980 | month (1-12) | day (1-31) | }
Byt2 := (((Year - 1980) and $00FF) shl 1) + (month shr 3);
Byt1 := ((month and 7) shl 5) + day;
end;
{=================================================}
begin
WriteLn('Diskette in drive ',drive,' has no label.');
new_label := '';
Write('Enter label, or just <return> to quit :');
ReadLn(new_label);
if new_label <> '' then
begin
with dir_sectors[Free_sector] do { Get the sector with }
GetSector('R',drive,side,sector,track,OKAY); { the first free entry }
if OKAY then { back into the buffer }
begin
with buffer[Free_Entry] do
begin
for N := 1 to length(new_label) do
name[N] := new_label[N];
if length(new_label) < 11 then
for N := length(new_label)+1 to 11 do
name[N] := ' ';
attribute := 8;
for N := 1 to 10 do Junk1[N] := 0;
GetTime(time[1],time[2]);
GetDate(date[1],date[2]);
for N := 1 to 6 do Junk2[N] := 0;
end; {with}
with dir_sectors[Free_sector] do
GetSector('W',drive,side,sector,track,OKAY);
if OKAY then
WriteLn('Sucessfully created label ',new_label,' for drive ',drive);
end; { if OKAY}
end; {if not = ''}
end;
{@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@}
begin
MakeTitle('LABEL',1); { This procedure is in TITLES.LIB }
window(1,10,80,25);
ClrScr;
repeat
gotoXY(1,WhereY); ClrEOL;
Write('Which drive? ');
Read(drive);
drive := UpCase(drive);
until drive in ['A'..'D'];
WriteLn;
DirectoryMap;
FindLabel;
if found then
begin
WriteLn('Current label is ',the_label);
new_label := '';
Write('Enter new label, or <return> to leave alone: ');
readLn(new_label);
if new_label <> '' then WriteNewLabel;
end
else CreateLabel;
end.